EXPERIMENT 4_bikeshare data

Data Packages

Baseine pacakges for our analysis

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────────────────────────────────────────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.3     ✔ readr     2.1.4
✔ forcats   1.0.0     ✔ stringr   1.5.0
✔ ggplot2   3.4.3     ✔ tibble    3.2.1
✔ lubridate 1.9.2     ✔ tidyr     1.3.0
✔ purrr     1.0.2     ── Conflicts ────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors

library(janitor)

Attaching package: ‘janitor’

The following objects are masked from ‘package:stats’:

    chisq.test, fisher.test

library(here)

here() starts at U:/DS241/bikeshare_23

library(openmeteo)

Loading the Bikeshare Raw Data

df1 <- read_csv("data_raw/202309-capitalbikeshare-tripdata.csv", show_col_types = FALSE) %>% clean_names()

Creating Dataframe 2 - Interjoing

df2s=df1 %>% 
  select(rideable_type,member_casual,
                    contains("start"),ride_id)%>% 
  mutate(start_stop="start")%>%
  rename(t=started_at,
        station_name=start_station_name,
        station_id=start_station_id,
        lat=start_lat,
        lng=start_lng)

df2e=df1 %>%
select(ride_id,rideable_type,member_casual,
                    contains("end")) %>%
  mutate(start_stop="stop") %>%
  rename(t=ended_at,
        station_name=end_station_name,
        station_id=end_station_id,
        lat=end_lat,
        lng=end_lng)

df2=bind_rows(df2s,df2e) %>%
  arrange(t) %>%
  mutate(rider_delta=(start_stop=="start")*2-1) %>% #change in ridership 
  mutate(riders=cumsum(rider_delta)) %>%
  relocate(riders,.after=t)

Plotting the Dataframe

df2 %>% 
  ggplot(aes(t,riders)) +
  geom_line()

Creating a subsampled dataset

df_s=df2 %>% slice_head(n=1000)

Why looking at slicing to every one hundredth data point will be bad? - Will likely track features however will jump data points whether the data is sparse or not. Want the data to be equally spaced in time.

Starting with 100 rows to get the calculation right and then see if oyu can do it with a bigger data set. Data stored in number of seconds based on a reference point

Round down to the nearest 10 mins, relocate t_f next to t, and filter the data points by t_f

df_e=df_s |>
  mutate(t_f=floor_date(t, "10 mins")) %>%
   relocate(t_f,.after=t) %>%
  slice_head(n=1,by=t_f)

Applying to Previous Manipulations to the Entire Data Set

df_r=df2 |>
  mutate(t_f=floor_date(t,"10 mins")) %>%
  relocate(t_f,.after=t) %>%
  slice_head(n=1,by=t_f)

Creating the Associated Plot

p1=df2 %>% 
  filter(day(t)==18) %>%
  ggplot(aes(x=t, y=riders)) +
  geom_line() +
  ggtitle("Riders on 18Sep")

p1+
  geom_line(data=df_r %>% filter(day(t)==18),
  color="red")

df_r=df2 |>
  mutate(t_f=floor_date(t,"1 mins")) %>%
  relocate(t_f,.after=t) %>%
  slice_head(n=1,by=t_f)

p1=df2 %>% 
  filter(day(t)==18) %>%
  ggplot(aes(x=t, y=riders)) +
  geom_line() +
  ggtitle("Riders on 18Sep")

p1+
  geom_line(data=df_r %>% filter(day(t)==18),
  color="red")

% Get Weather Data

df_w=weather_history("Washington",
                    start = "2023-09-01",
                    end = "2023-09-30",
                    hourly = c("apparent_temperature",
                            "wind_speed_10m",
                            "precipitation")
)

`geocode()` has matched "Washington" to:
Washington in Washington, D.C., United States
Population: 601723
Co-ordinates: c(38.89511, -77.03637)

Merging bike and weather data

df_s=df2 %>% slice_sample(n=1000)
df_j=df_s %>% left_join(df_w,
                        by=join_by(closest(t>=datetime)))

df_j=df_s %>% 
   left_join(df_w,by=join_by(closest(t>=datetime)))  %>%
   relocate(datetime, .after=t)
 
head(df_j)

Investigating the Time Zone Mismatch Between the Bikeshare and Weather Datasets

df_j$t[1:5]

[1] "2023-09-05 07:07:28 UTC" "2023-09-22 11:00:32 UTC" "2023-09-14 10:05:05 UTC" "2023-09-09 09:17:47 UTC"
[5] "2023-09-08 15:10:02 UTC"

df_j$datetime[1:5]

[1] "2023-09-05 03:00:00 EDT" "2023-09-22 07:00:00 EDT" "2023-09-14 06:00:00 EDT" "2023-09-09 05:00:00 EDT"
[5] "2023-09-08 11:00:00 EDT"

Sys.timezone()

[1] "America/New_York"

df_s_est <- force_tz(df_s, tzone = "America/New_York")

df_j_est=df_s_est %>% 
   left_join(df_w,by=join_by(closest(t>=datetime)))  %>%
   relocate(datetime, .after=t)
 
head(df_j_est)

df_j_est$datetime[1:5]

[1] "2023-09-05 07:00:00 EDT" "2023-09-22 11:00:00 EDT" "2023-09-14 10:00:00 EDT" "2023-09-09 09:00:00 EDT"
[5] "2023-09-08 15:00:00 EDT"

df2$t[1:5]

[1] "2023-09-01 00:00:44 UTC" "2023-09-01 00:01:48 UTC" "2023-09-01 00:01:48 UTC" "2023-09-01 00:02:03 UTC"
[5] "2023-09-01 00:02:21 UTC"

force_tz(df2$t[1:5],"America/New_York")

[1] "2023-09-01 00:00:44 EDT" "2023-09-01 00:01:48 EDT" "2023-09-01 00:01:48 EDT" "2023-09-01 00:02:03 EDT"
[5] "2023-09-01 00:02:21 EDT"

df2c=df2 %>% mutate(t=force_tz(t,tzone="America/New_York")) #corrected
 
df_s2=df2c %>% slice_sample(n=1000)
 
df_j2=df_s2 %>% 
   left_join(df_w,by=join_by(closest(t>=datetime)))  %>%
   relocate(datetime, .after=t)
 
head(df_j2)

NA
NA

dfc=df2c %>% 
  left_join(df_w,by=join_by(closest(t>=datetime)))  %>%
   relocate(datetime, .after=t) %>%
  rename(atemp=hourly_apparent_temperature,
         wind=hourly_wind_speed_10m,
         prec=hourly_precipitation)

A Visualization of the Data

Coloring when the rain is greater than 1- color each point based on whether it was raining or not

p2=dfc %>%
  ggplot(aes(x=t,y=riders,color=prec>1)) +
  geom_point()
p2

NA

p3 = dfc %>%
  filter(day(t)==23) %>%
  ggplot(aes(t,riders,color=wind))+
  geom_point() +
  ggtitle("Riders vs. Precipitation on Sep 10")

p3

plotly::ggplotly(p3)